home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-09-16 | 17.6 KB | 521 lines | [TEXT/CCL2] |
- (in-package :traps)
- ;
- ; File: TextEdit.p
- ;
- ; Copyright: © 1983-1993 by Apple Computer, Inc.
- ; All rights reserved.
- ;
- ; Version: System 7.1 for ETO #11
- ; Created: Tuesday, March 30, 1993 18:00
- ;
- ; Adapted for MCL 2.0 by Gilles Serasset, GETA-IMAG, France
- ;
-
- ;$IFC UNDEFINED UsingIncludes
- ;$SETC UsingIncludes := 0
- ;$ENDC}
- ;
- ;$IFC NOT UsingIncludes
- ; UNIT TextEdit;
- ; INTERFACE
- ;$ENDC
- ;
- ;$IFC UNDEFINED UsingTextEdit
- ;$SETC UsingTextEdit := 1
- ;
- ;$I+
- ;$SETC TextEditIncludes := UsingIncludes
- ;$SETC UsingIncludes := 1
- ;$IFC UNDEFINED UsingQuickdraw
- ;$I $$Shell(PInterfaces)Quickdraw.p
-
- (require-interface 'QUICKDRAW) ; $I $$Shell(PInterfaces)Quickdraw.p
-
- ;$ENDC
- ;$SETC UsingIncludes := TextEditIncludes
-
-
- ;{ Justification (word alignment) styles }
-
- (defconstant $teJustLeft 0);
- (defconstant $teJustCenter 1);
- (defconstant $teJustRight -1);
- (defconstant $teForceLeft -2);
-
- ;{ new names for the Justification (word alignment) styles }
- (defconstant $teFlushDefault 0); ;{flush according to the line direction }
- (defconstant $teCenter 1); ;{center justify (word alignment) }
- (defconstant $teFlushRight -1); ;{flush right for all scripts }
- (defconstant $teFlushLeft -2); ;{flush left for all scripts }
-
- ;{ Set/Replace style modes }
- (defconstant $fontBit 0); ;{set font}
- (defconstant $faceBit 1); ;{set face}
- (defconstant $sizeBit 2); ;{set size}
- (defconstant $clrBit 3); ;{set color}
- (defconstant $addSizeBit 4); ;{add size mode}
- (defconstant $toggleBit 5); ;{set faces in toggle mode}
- (defconstant $toglBit 5); ;{ obsolete. use toggleBit }
-
- ;{ TESetStyle/TEContinuousStyle modes }
- (defconstant $doFont 1); ;{ set font (family) number}
- (defconstant $doFace 2); ;{set character style}
- (defconstant $doSize 4); ;{set type size}
- (defconstant $doColor 8); ;{set color}
- (defconstant $doAll 15); ;{set all attributes}
- (defconstant $addSize 16); ;{adjust type size}
- (defconstant $doToggle 32); ;{toggle mode for TESetStyle & TEContinuousStyle}
-
- ;{ offsets into TEDispatchRec }
- (defconstant $EOLHook 0); ;{[ProcPtr] TEEOLHook}
- (defconstant $DRAWHook 4); ;{[ProcPtr] TEWidthHook}
- (defconstant $WIDTHHook 8); ;{[ProcPtr] TEDrawHook}
- (defconstant $HITTESTHook 12); ;{[ProcPtr] TEHitTestHook}
- (defconstant $nWIDTHHook 24); ;{[ProcPtr] nTEWidthHook}
- (defconstant $TextWidthHook 28); ;{[ProcPtr] TETextWidthHook}
-
- ;{ selectors for TECustomHook }
- (defconstant $intEOLHook 0); ;{TEIntHook value}
- (defconstant $intDrawHook 1); ;{TEIntHook value}
- (defconstant $intWidthHook 2); ;{TEIntHook value}
- (defconstant $intHitTestHook 3); ;{TEIntHook value}
- (defconstant $intNWidthHook 6); ;{TEIntHook value for new version of WidthHook}
- (defconstant $intTextWidthHook 7); ;{TEIntHook value for new TextWidthHook}
-
- ;{ feature or bit definitions for TEFeatureFlag }
- (defconstant $teFAutoScroll 0); ;{00000001b}
- (defconstant $teFAutoScr 0); ;{00000001b obsolete. use teFAutoScroll}
- (defconstant $teFTextBuffering 1); ;{00000010b}
- (defconstant $teFOutlineHilite 2); ;{00000100b}
- (defconstant $teFInlineInput 3); ;{00001000b obsolete}
- (defconstant $teFUseTextServices 4); ;{00010000b obsolete}
-
- ;{ action for the new "bit (un)set" interface, TEFeatureFlag }
- (defconstant $teBitClear 0);
- (defconstant $teBitSet 1); ;{set the selector bit}
- (defconstant $teBitTest -1); ;{no change; just return the current setting}
-
- ;{constants for identifying the routine that called FindWord }
- (defconstant $teWordSelect 4); ;{clickExpand to select word}
- (defconstant $teWordDrag 8); ;{clickExpand to drag new word}
- (defconstant $teFromFind 12); ;{FindLine called it ($0C)}
- (defconstant $teFromRecal 16); ;{RecalLines called it ($10) obsolete}
-
- ;{constants for identifying DoText selectors }
- (defconstant $teFind 0); ;{DoText called for searching}
- (defconstant $teHighlight 1); ;{DoText called for highlighting}
- (defconstant $teDraw -1); ;{DoText called for drawing text}
- (defconstant $teCaret -2); ;{DoText called for drawing the caret}
-
-
- (def-mactype :teptr (find-mactype :pointer))
- (def-mactype :tehandle (find-mactype :handle))
-
- (DEFRECORD (TEREC :HANDLE)
- (destRect :RECT)
- (viewRect :RECT)
- (selRect :RECT)
- (lineHeight :SIGNED-INTEGER)
- (fontAscent :SIGNED-INTEGER)
- (selPoint :POINT)
- (selStart :SIGNED-INTEGER)
- (selEnd :SIGNED-INTEGER)
- (active :SIGNED-INTEGER)
- (wordBreak :POINTER)
- (clikLoop :POINTER)
- (clickTime :SIGNED-LONG)
- (clickLoc :SIGNED-INTEGER)
- (caretTime :SIGNED-LONG)
- (caretState :SIGNED-INTEGER)
- (just :SIGNED-INTEGER)
- (teLength :SIGNED-INTEGER)
- (hText :HANDLE)
- ;{ recalBack: INTEGER; }
- ;{ recalLines: INTEGER; }
- (hDispatchRec :signed-long)
- (clikStuff :SIGNED-INTEGER)
- (crOnly :SIGNED-INTEGER)
- (txFont :SIGNED-INTEGER)
- (txFace :UNSIGNED-BYTE)
- (txMode :SIGNED-INTEGER)
- (txSize :SIGNED-INTEGER)
- (inPort (:POINTER GRAFPORT))
- (highHook :POINTER)
- (caretHook :POINTER)
- (nLines :SIGNED-INTEGER)
- (lineStarts (:ARRAY :SIGNED-INTEGER 16001)))
-
-
- (def-mactype :CharsPtr (find-mactype :pointer))
- (def-mactype :CharsHandle (find-mactype :handle))
-
- (defrecord (Chars :handle) (array (array :character 32001)))
-
- (defrecord StyleRun
- (startChar :signed-integer) ; starting character position
- (styleIndex :signed-integer) ; index in style table
- )
-
- (DEFRECORD STELEMENT
- (STCOUNT :SIGNED-INTEGER)
- (STHEIGHT :SIGNED-INTEGER)
- (STASCENT :SIGNED-INTEGER)
- (STFONT :SIGNED-INTEGER)
- (STFACE :UNSIGNED-BYTE)
- (STSIZE :SIGNED-INTEGER)
- (STCOLOR :RGBCOLOR))
-
- (def-mactype :stptr (find-mactype :pointer))
- (def-mactype :sthandle (find-mactype :handle))
-
- (defrecord (TEStyleTable :handle) (array (array :stelement 1777)))
-
- (defrecord LHElement
- (lhHeight :signed-integer) ; maximum height in line
- (lhAscent :signed-integer) ; maximum ascent in line
- )
-
- (def-mactype :lhptr (find-mactype :pointer))
- (def-mactype :lhhandle (find-mactype :handle))
-
- (defrecord (LHTable :handle) (array (array :lhelement 8001)))
-
- (DEFRECORD SCRPSTELEMENT
- (SCRPSTARTCHAR :SIGNED-LONG)
- (SCRPHEIGHT :SIGNED-INTEGER)
- (SCRPASCENT :SIGNED-INTEGER)
- (SCRPFONT :SIGNED-INTEGER)
- (SCRPFACE :UNSIGNED-BYTE)
- (SCRPSIZE :SIGNED-INTEGER)
- (SCRPCOLOR :RGBCOLOR))
-
-
- (defrecord ScrpSTTable (array (array :scrpstelement 1601)))
-
- (def-mactype :stscrpptr (find-mactype :pointer))
- (def-mactype :stscrphandle (find-mactype :handle))
- (defrecord (StScrpRec :handle)
- (scrpNStyles :signed-integer); number of styles in scrap
- (scrpStyleTab :scrpsttable) ; table of styles for scrap
- )
-
- (def-mactype :nullstptr (find-mactype :pointer))
- (def-mactype :nullsthandle (find-mactype :handle))
- (defrecord (NullStRec :handle)
- (teReserved :signed-long) ; reserved for future expansion
- (nullScrap (:handle :stscrprec)); handle to scrap style table
- )
-
- (def-mactype :testyleptr (find-mactype :pointer))
- (def-mactype :testylehandle (find-mactype :handle))
- (defrecord (TEStyleRec :handle)
- (nRuns :signed-integer) ; number of style runs
- (nStyles :signed-integer) ; size of style table
- (styleTab (:handle :testyletable)); handle to style table
- (lhTab (:handle :lhtable)) ; handle to line-height table
- (teRefCon :signed-long) ; reserved for application use
- (nullStyle (:handle :nullstrec)); Handle to style set at null selection
- (runs (:array :stylerun 8001)); ARRAY [0..8000] OF StyleRun
- )
-
- (def-mactype :textstyleptr (find-mactype :pointer))
- (def-mactype :textstylehandle (find-mactype :handle))
- (DEFRECORD (TEXTSTYLE :HANDLE)
- (TSFONT :SIGNED-INTEGER)
- (TSFACE :UNSIGNED-BYTE)
- (TSSIZE :SIGNED-INTEGER)
- (TSCOLOR :RGBCOLOR))
-
- (def-mactype :teinthook (find-mactype :signed-integer))
-
-
- (deftrap _teinit nil
- nil
- (:stack-trap #xA9CC))
-
- (deftrap _tenew ((destrect :rect) (viewrect :rect))
- (:stack (:handle :terec))
- (:stack-trap #xA9D2))
-
- (deftrap _tedispose ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9CD))
-
- (deftrap _tesettext ((text :pointer) (length :signed-long) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9CF))
-
- (deftrap _tegettext ((hte (:handle :terec)))
- (:stack (:handle :chars))
- (:stack-trap #xA9CB))
-
- (deftrap _teidle ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9DA))
-
- (deftrap _tesetselect ((selstart :signed-long) (selend :signed-long) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9D1))
-
- (deftrap _teactivate ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9D8))
-
- (deftrap _tedeactivate ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9D9))
-
- (deftrap _tekey ((key :character) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9DC))
-
- (deftrap _tecut ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9D6))
-
- (deftrap _tecopy ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9D5))
-
- (deftrap _tepaste ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9DB))
-
- (deftrap _tedelete ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9D7))
-
- (deftrap _teinsert ((text :pointer) (length :signed-long) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9DE))
-
- (deftrap _tesetalignment ((just :signed-integer) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9DF))
-
- (deftrap _tesetjust ((just :signed-integer) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9DF))
-
- (deftrap _teupdate ((rupdate :rect) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9D3))
-
- (deftrap _tetextbox ((text :pointer) (length :signed-long) (box :rect) (just :signed-integer))
- nil
- (:stack-trap #xA9CE))
-
- (deftrap _TextBox ((text :pointer) (length :signed-long) (box :rect) (just :signed-integer))
- nil
- (:stack-trap #xA9CE))
-
- (deftrap _tescroll ((dh :signed-integer) (dv :signed-integer) (hte (:handle :terec)))
- nil
- (:stack-trap #xA9DD))
-
- (deftrap _teselview ((hte (:handle :terec)))
- nil
- (:stack-trap #xA811))
-
- (deftrap _tepinscroll ((dh :signed-integer) (dv :signed-integer) (hte (:handle :terec)))
- nil
- (:stack-trap #xA812))
-
- (deftrap _teautoview ((fauto :boolean) (hte (:handle :terec)))
- nil
- (:stack-trap #xA813))
-
- (deftrap _tescraphandle nil
- (:no-trap :handle)
- (:no-trap (%get-signed-long (%int-to-ptr 2740))))
-
- (deftrap _tecaltext ((hte (:handle :terec)))
- nil
- (:stack-trap #xA9D0))
-
- (deftrap _tegetoffset ((pt :point) (hte (:handle :terec)))
- (:stack :signed-integer)
- (:stack-trap #xA83C))
-
- (deftrap _tegetpoint ((offset :signed-integer) (hte (:handle :terec)))
- (:stack :point)
- (:stack-trap #xA83D offset hte (8 :signed-integer)))
-
- (deftrap _teclick ((pt :point) (fextend :boolean) (h (:handle :terec)))
- nil
- (:stack-trap #xA9D4))
-
- (deftrap _testylenew ((destrect :rect) (viewrect :rect))
- (:stack (:handle :terec))
- (:stack-trap #xA83E))
-
- (deftrap _testylnew ((destrect :rect) (viewrect :rect))
- (:stack (:handle :terec))
- (:stack-trap #xA83E))
-
- (deftrap _SetStylHandle ((thehandle (:handle :testylerec)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D thehandle hte (5 :signed-integer)))
-
- (deftrap _SetStyleHandle ((thehandle (:handle :testylerec)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D thehandle hte (5 :signed-integer)))
-
- (deftrap _tesetstylehandle ((thehandle (:handle :testylerec)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D thehandle hte (5 :signed-integer)))
-
- (deftrap _GetStylHandle ((hte (:handle :terec)))
- (:stack (:handle :testylerec))
- (:stack-trap #xA83D hte (4 :signed-integer)))
-
- (deftrap _GetStyleHandle ((hte (:handle :terec)))
- (:stack (:handle :testylerec))
- (:stack-trap #xA83D hte (4 :signed-integer)))
-
- (deftrap _TEGetStyleHandle ((hte (:handle :terec)))
- (:stack (:handle :testylerec))
- (:stack-trap #xA83D hte (4 :signed-integer)))
-
-
- (deftrap _tegetstyle ((offset :signed-integer) (thestyle (:pointer :textstyle)) (lineheight (:pointer :signed-integer)) (fontascent (:pointer :signed-integer)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D offset thestyle lineheight fontascent hte (3 :signed-integer)))
-
- (deftrap _TEStylPaste ((hte (:handle :terec)))
- nil
- (:stack-trap #xA83D hte (0 :signed-integer)))
-
- (deftrap _TEStylePaste ((hte (:handle :terec)))
- nil
- (:stack-trap #xA83D hte (0 :signed-integer)))
-
- (deftrap _tesetstyle ((mode :signed-integer) (newstyle :textstyle) (redraw :boolean) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D mode newstyle redraw hte (1 :signed-integer)))
-
- (deftrap _tereplacestyle ((mode :signed-integer) (oldstyle :textstyle) (newstyle :textstyle) (redraw :boolean) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D mode oldstyle newstyle redraw hte (2 :signed-integer)))
-
- (deftrap _tegetstylescraphandle ((hte (:handle :terec)))
- (:stack (:handle :stscrprec))
- (:stack-trap #xA83D hte (6 :signed-integer)))
-
- (deftrap _GetStylScrap ((hte (:handle :terec)))
- (:stack (:handle :stscrprec))
- (:stack-trap #xA83D hte (6 :signed-integer)))
-
- (deftrap _GetStyleScrap ((hte (:handle :terec)))
- (:stack (:handle :stscrprec))
- (:stack-trap #xA83D hte (6 :signed-integer)))
-
- (deftrap _TEStylInsert ((text :pointer) (length :signed-long) (hst (:handle :stscrprec)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D text length hst hte (7 :signed-integer)))
-
- (deftrap _TEStyleInsert ((text :pointer) (length :signed-long) (hst (:handle :stscrprec)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D text length hst hte (7 :signed-integer)))
-
- (deftrap _tegetheight ((endline :signed-long) (startline :signed-long) (hte (:handle :terec)))
- (:stack :signed-long)
- (:stack-trap #xA83D endline startline hte (9 :signed-integer)))
-
- (deftrap _tecontinuousstyle ((mode (:pointer :signed-integer)) (astyle (:pointer :textstyle)) (hte (:handle :terec)))
- (:stack :boolean)
- (:stack-trap #xA83D mode astyle hte (10 :signed-integer)))
-
- (deftrap _SetStylScrap ((rangestart :signed-long) (rangeend :signed-long) (newstyles (:handle :stscrprec)) (redraw :boolean) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D rangestart rangeend newstyles redraw hte (11 :signed-integer)))
-
- (deftrap _SetStyleScrap ((rangestart :signed-long) (rangeend :signed-long) (newstyles (:handle :stscrprec)) (redraw :boolean) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D rangestart rangeend newstyles redraw hte (11 :signed-integer)))
-
- (deftrap _TEUseStyleScrap ((rangestart :signed-long) (rangeend :signed-long) (newstyles (:handle :stscrprec)) (redraw :boolean) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D rangestart rangeend newstyles redraw hte (11 :signed-integer)))
-
- (deftrap _tecustomhook ((which :signed-integer) (addr (:pointer :pointer)) (hte (:handle :terec)))
- nil
- (:stack-trap #xA83D which addr hte (12 :signed-integer)))
-
- (deftrap _tenumstyles ((rangestart :signed-long) (rangeend :signed-long) (hte (:handle :terec)))
- (:stack :signed-long)
- (:stack-trap #xA83D rangestart rangeend hte (13 :signed-integer)))
-
- (deftrap _tefeatureflag ((feature :signed-integer) (action :signed-integer) (hte (:handle :terec)))
- (:stack :signed-integer)
- (:stack-trap #xA83D feature action hte (14 :signed-integer)))
-
- (deftrap _TEGetScrapLength nil
- (:no-trap :signed-long)
- (:no-trap (%get-unsigned-word (%int-to-ptr #xAB0))))
-
- (deftrap _TEGetScrapLen nil
- (:no-trap :signed-long)
- (:no-trap (%get-unsigned-word (%int-to-ptr #xAB0))))
-
- (deftrap _TESetScrapLength ((length :signed-long))
- nil
- (:no-trap (%put-word length (%int-to-ptr #xAB0))))
-
- (deftrap _TESetScrapLength ((length :signed-long))
- nil
- (:no-trap (%put-word length (%int-to-ptr #xAB0))))
-
- (deftrap _TEFromScrap nil
- (:no-trap :OSErr)
- (:no-trap (block exit
- (rlet ((scrap-offset_p :long))
- (let ((scrap-size (#_GetScrap (%null-ptr) "TEXT" scrap-offset_p)))
- (when (minusp scrap-size) (return-from exit scrap-size))
- (when (> scrap-size 32000) (return-from exit #$teScrapSizeErr))
- (with-macptrs ((TEScrap_h (%get-ptr (%int-to-ptr #$TEScrpHandle))))
- (let ((ecode (#_GetScrap TEScrap_h "TEXT" scrap-offset_p)))
- (when (minusp ecode) (return-from exit ecode))
- (%put-word (%int-to-ptr #$TEScrpLength) scrap-size)
- #$noErr)))))))
-
- (deftrap _TEToScrap nil
- (:no-trap :OSErr)
- (:no-trap (with-macptrs ((TEScrap_h (%get-ptr (%int-to-ptr #$TEScrpHandle))))
- (with-dereferenced-handles ((TEScrap_p TEScrap_h))
- (#_PutScrap (%get-unsigned-word (%int-to-ptr #$TEScrpLength)) "TEXT" TEScrap_p)))))
-
-
- ; The "clikproc" should be defined with Assembler (vice Pascal) calling
- ; sequence.
- (deftrap _tesetclickloop ((clikproc :pointer) (hte (:handle :terec)))
- nil
- (:no-trap (setf (rref hte terec.clickloop) clickproc)))
-
- (deftrap _SetClikLoop ((clikproc :pointer) (hte (:handle :terec)))
- nil
- (:no-trap (setf (rref hte terec.clickloop) clickproc)))
-
- ; The "wbrkproc" should be defined with Assembler (vice Pascal) calling
- ; sequence.
- (deftrap _tesetwordbreak ((wbrkproc :pointer) (hte (:handle :terec)))
- nil
- (:no-trap (setf (ccl:rref hte terec.wordbreak) wbrkproc)))
-
- (deftrap _SetWordBreak ((wbrkproc :pointer) (hte (:handle :terec)))
- nil
- (:no-trap (setf (ccl:rref hte terec.wordbreak) wbrkproc)))
-
-
- (export '($teJustLeft $teJustCenter $teJustRight $teForceLeft $teFlushDefault
- $teCenter $teFlushRight $teFlushLeft $fontBit $faceBit $sizeBit $clrBit
- $addSizeBit $toggleBit $toglBit $doFont $doFace $doSize $doColor $doAll
- $addSize $doToggle $EOLHook $DRAWHook $WIDTHHook $HITTESTHook $nWIDTHHook
- $TextWidthHook $intEOLHook $intDrawHook $intWidthHook $intHitTestHook
- $intNWidthHook $intTextWidthHook $teFAutoScroll $teFAutoScr $teFTextBuffering
- $teFOutlineHilite $teFInlineInput $teFUseTextServices $teBitClear $teBitSet $teBitTest
- $teWordSelect $teWordDrag $teFromFind $teFromRecal $teFind $teHighlight $teDraw
- $teCaret
- ))
- (provide-interface 'TEXTEDIT)
-